home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / AMIGA / AMICUS / AMICUS24.ADF / CodeDemo / CodeDemo.mod < prev    next >
Text File  |  1988-04-16  |  23KB  |  504 lines
  1.  
  2. (*  Authors = Steve Wilkinson and J.E. Gilpin
  3.  
  4.     Developed using Modula-2/Amiga TDI Software Inc. Dallas,Texas
  5.                     Asm68k 68010 Macro Assembler V 1.2.1
  6.  
  7.     Released to Public Domain Sept. 1987.
  8.     Permission to Alter, Copy and Redistribute granted by Authors.*)
  9.  
  10. (*    The sole purpose of this Program is to demonstrate the use
  11.     of Assembly language routines in Modula-2 CODE Statements.
  12.     The functions performed by the Assembly Language routine
  13.     can be more efficiently done using built-in Amiga procedures
  14.     and co-processor hardware.
  15.       Unless you completely understand Modula-2 and Amiga register
  16.     conventions, you may find it difficult to use Assembly Language
  17.     routines in Modula-2 CODE statements. Registers A0 and D0 are
  18.     listed as scratch registers in most Amiga literature, so it
  19.     should be safe to use them for In-line Assembly routines.
  20.     If you want to use more registers, preserve the State of the
  21.     machine as completely as possible.
  22.  
  23.       The key to successful Assembly routines in Modula-2 CODE
  24.     statements is register preservation.
  25.     You can achieve that by:
  26.         1. Passing parameters to your routine using a scratch
  27.            register such as A0.
  28.         2. Pushing all registers to the stack at the beginning
  29.            of your routine and restoring them at the end.
  30.  
  31.       In addition, defining data memory in Modula-2 and passing
  32.     a data pointer to the Assembly routine seems to work better
  33.     than trying to create data space in Assembly routine.
  34.       The final routine must be derived from the Assembler
  35.     object file output. An executable routine contains loader
  36.     information and may not work as in-line code in Modula-2.
  37.     Symbolic external references must be avoided since they
  38.     require resolution by a linker. *)
  39.  
  40. (*   The Program "AsmToCode" is included with this ARC file.
  41.    It automatically converts Assembler object files into
  42.    a Modula-2 CODE statement. You can manually convert
  43.    the object file listing into numerical text, but that can
  44.    be a tedious process at best.
  45.      "AsmToCode" simplifies the process. To use "AsmToCode"
  46.    just enter "AsmToCode <objectfilename>" from CLI.
  47.    The program will produce a file with the same name as
  48.    the original, but with the extension stripped and the
  49.    extension ".cnv" added. *)
  50.   
  51.  
  52. MODULE CODEDemo;
  53.  
  54. FROM InOut IMPORT WriteString, WriteLn;
  55. FROM SYSTEM IMPORT NULL, ADDRESS, ADR, BYTE, CODE, ASH,
  56.      REGISTER,SETREG,TSIZE;
  57. FROM Intuition IMPORT ScreenPtr, IntuitionBase, IntuitionName,
  58.      CustomScreen;
  59. FROM GraphicsLibrary IMPORT GraphicsName, GraphicsBase, 
  60.      DrawingModeSet, DrawingModes;
  61. FROM Pens IMPORT Move, RectFill, SetAPen, SetDrMd;
  62. FROM Rasters IMPORT RastPortPtr, SetRast;
  63. FROM Views IMPORT Modes, ModeSet,WaitTOF;
  64. FROM Screens IMPORT OpenScreen, CloseScreen, NewScreen;
  65. FROM Text IMPORT Text;
  66. FROM Libraries IMPORT OpenLibrary, CloseLibrary;
  67. FROM DOSProcessHandler IMPORT Delay;
  68. FROM Nodes IMPORT Node,NodeType;
  69. FROM Tasks IMPORT Task,TaskPtr,AddTask,RemTask;
  70. FROM Interrupts IMPORT Interrupt,InterruptPtr,AddIntServer,
  71.      RemIntServer,Forbid,Permit;
  72. FROM Memory IMPORT AllocMem,FreeMem,MemReqSet,MemClear,
  73.      MemChip,MemPublic;
  74. FROM Sprites IMPORT SimpleSprite,GetSprite,MoveSprite,
  75.      ChangeSprite,FreeSprite;
  76.  
  77. TYPE
  78.   codeinfotype = RECORD
  79.                    BPlane1 : ADDRESS;
  80.                    BPlane2 : ADDRESS;
  81.                    count   : CARDINAL; (* word counter for picture *)
  82.                  END; (* RECORD codeinfo *)
  83.   SpriteImage = ARRAY [0..17] OF CARDINAL;
  84.   SpriteImagePtr = POINTER TO SpriteImage;
  85.  
  86. VAR                        (* We are using lots of Global Variables *)
  87.   scrnptr : ScreenPtr;     (* because we are seperating this Module *)
  88.   ns      : NewScreen;     (* into a Task, an Interrupt, and a      *)
  89.   codeinfo: codeinfotype;  (* controlling Process. The Globals let  *)
  90.   x, y    : CARDINAL;      (* us communicate and transfer data      *)
  91.   rp      : RastPortPtr;   (* without suspending execution using    *)
  92.   RegStore: ADDRESS;       (* Wait or WaitPort statements.          *)
  93.   message : ARRAY [0..30] OF CHAR;
  94.   ServiceNode          : Node;
  95.   WalkTaskPoint        : TaskPtr;
  96.   WalkSize             : LONGCARD;
  97.   KillDemo             : ARRAY [0..8] OF CHAR;
  98.   KillerPoint          : InterruptPtr;
  99.   Killer               : Interrupt;
  100.   FlySprite            : INTEGER;
  101.   Fly                  : ARRAY [0..3] OF SpriteImagePtr;
  102.   SpriteData           : SimpleSprite;
  103.   number,terminate     : CARDINAL;
  104.   name                 : ARRAY [0..7] OF CHAR;
  105.  
  106. PROCEDURE Kill;        (* Keyboard or Disk activity will activate *)
  107.   BEGIN                (* this Interrupt Server Routine. It will  *)
  108.     codeinfo.count:=0; (* clear a Global Variable, which our      *)
  109.   END Kill;            (* Assembly Routine will detect and        *)
  110.                        (* respond to by terminating.              *)
  111.  
  112. (* The following Procedure is converted into a Task and           *)
  113. (* launched into coprocessing. It communicates with the parent    *)
  114. (* process through the Global Variable "terminate". If the        *)
  115. (* parent process clears that variable to zero the Task stops     *)
  116. (* and waits to be removed. If we let it terminate on its own     *)
  117. (* it will corrupt the Operating System. The culprit might be the *)
  118. (* Modula 2 Exit Code. Using the P- Compiler option might cure    *)
  119. (* the problem and elimitate the need for the LOOP END statements *)
  120.  
  121. PROCEDURE Walk;
  122.   BEGIN
  123.       WHILE (terminate <> 0) DO
  124.         WaitTOF; WaitTOF;
  125.         ChangeSprite(ADR(scrnptr^.VPort),SpriteData,Fly[number]);
  126.         number:=number+1; IF (number > 3) THEN number:=0; END;
  127.       END;
  128.       terminate:=2; LOOP END;
  129.   END Walk;
  130.  
  131. PROCEDURE MakeInterrupt;      (* This Procedure sets up our Interrupt *)
  132.                               (* Server Routine. Notice that we are   *)
  133.   BEGIN                       (* putting a Node directly into a       *)
  134.     KillerPoint:=ADR(Killer); (* Modula 2 Record instead of doing     *)
  135.     KillDemo:="KillDemo";     (* an AllocMem and referencing it with  *)
  136.     KillDemo[8]:=CHR(0);      (* Pointer. God Forbid !! I don't know  *)
  137.     WITH ServiceNode DO       (* if the Operating System can relocate *)
  138.       lnSucc:=NULL;           (* our Modula 2 data after it starts    *)
  139.       lnPred:=NULL;           (* our program. If so we might get into *)
  140.       lnType:=BYTE(NTInterrupt); (* trouble doing it this way.        *)
  141.       lnPri:=BYTE(0);
  142.       lnName:=ADR(KillDemo);
  143.     END;
  144.     WITH Killer DO
  145.       isNode:=ServiceNode;
  146.       isData:=ADR(codeinfo.count);
  147.       isCode:=Kill;
  148.     END;
  149.   END MakeInterrupt;
  150.  
  151. PROCEDURE MakeFly;      (* This procedure creates the image data    *)
  152.                         (* for the "Walk" Task to manipulate.       *)
  153.   VAR                   (* This data must be in Chip memory so the  *)
  154.     MemAddress:ADDRESS; (* graphics hardware can access it.         *)
  155.     num:CARDINAL;
  156.   BEGIN
  157.     Fly[0]:=NULL; number:=0;
  158.     MemAddress:=AllocMem(LONG(200),MemReqSet{MemClear,MemChip,MemPublic});
  159.     IF (MemAddress<>0) THEN
  160.       Fly[0]:=MemAddress; Fly[1]:=MemAddress+LONG(50);
  161.       Fly[2]:=MemAddress+LONG(100); Fly[3]:=MemAddress+LONG(150);
  162.  
  163.       FOR num:=0 TO 17 DO Fly[0]^[num]:=00000H; END;
  164.       Fly[0]^[0]:=50; Fly[0]^[1]:=100;
  165.       Fly[0]^[3]:=01240H; Fly[0]^[5]:=00A80H;
  166.       Fly[0]^[7]:=03FC0H; Fly[0]^[9]:=01FE0H;
  167.       Fly[0]^[11]:=03FC0H; Fly[0]^[13]:=00A80H;
  168.       Fly[0]^[15]:=01240H; 
  169.       FOR num:=0 TO 15 DO
  170.         Fly[1]^[num]:=Fly[0]^[num]; Fly[2]^[num]:=Fly[0]^[num];
  171.         Fly[3]^[num]:=Fly[0]^[num];
  172.       END;
  173.       Fly[1]^[3]:=02900H; Fly[1]^[5]:=01500H;
  174.       Fly[3]^[13]:=01500H; Fly[3]^[15]:=02900H;
  175.  
  176.       WITH SpriteData DO
  177.         posCtlData:=Fly[0];
  178.         height:=7;
  179.         x:=50;
  180.         y:=100;
  181.         num:=0;
  182.       END;
  183.       FlySprite:=GetSprite(SpriteData,-1);
  184.       IF (FlySprite <> -1) THEN 
  185.         MoveSprite(ADR(scrnptr^.VPort),SpriteData,50,100);
  186.       END;
  187.     END; 
  188.   END MakeFly;
  189.  
  190. PROCEDURE StartWalk; (* This Procedure Initializes our "Walk" Task *)
  191.                      (* and launches it into action. It's a direct *)
  192.                      (* conversion from a C language routine,      *)
  193.   VAR                (* which is why it doesn't make any sense.    *)
  194.     stacksize,datasize:LONGCARD;
  195.   BEGIN
  196.     name:="DoWalk"; name[7]:=CHR(0); stacksize:=1000;
  197.     datasize:=ASH(stacksize,-2); datasize:=ASH(datasize,2);
  198.     WalkSize:=TSIZE(Task)+datasize; terminate:=1;
  199.     datasize:=ASH(WalkSize,-1); datasize:=ASH(datasize,1);
  200.     WalkTaskPoint:=AllocMem(WalkSize,MemReqSet{MemClear,MemPublic});
  201.     IF (WalkTaskPoint <> NULL) THEN
  202.       WITH WalkTaskPoint^ DO
  203.         WITH tcNode DO
  204.           lnType:=BYTE(NTTask);
  205.           lnPri:=BYTE(0);
  206.           lnName:=ADR(name);
  207.         END;
  208.         tcSPLower:=ADDRESS(WalkTaskPoint) + TSIZE(Task);
  209.         tcSPUpper:=ADDRESS(WalkTaskPoint) + ADDRESS(datasize);
  210.         tcSPReg:=tcSPUpper;
  211.       END;
  212.       AddTask(WalkTaskPoint,ADDRESS(Walk),0);
  213.     END;   
  214.   END StartWalk;     
  215.  
  216. PROCEDURE Setup; (* This Procedure opens the libraries *)
  217.                  (* and opens our screen.              *)  
  218.   BEGIN
  219.     GraphicsBase  := OpenLibrary (GraphicsName, 0);
  220.     IntuitionBase := OpenLibrary (IntuitionName,0);
  221.     IF (IntuitionBase = 0) OR (GraphicsBase = 0)THEN
  222.       WriteString ('Library error');
  223.       WriteLn;
  224.       HALT;
  225.     END; (* IF IntuitionBase *)
  226.  
  227.     WITH ns DO
  228.       LeftEdge := 0; TopEdge := 0;
  229.       Width := 320; Height := 200; Depth := 2; (* don't need 32 clrs*)
  230.       DetailPen := BYTE(-1); BlockPen := BYTE(-1); (* any color*)
  231.       ViewModes := ModeSet {};                     (* no special modes *)
  232.       Type := CustomScreen;
  233.       Font := NULL;                                (* no special font  *)
  234.       DefaultTitle := NULL;                        (* no screen title  *)
  235.       Gadgets := NULL;                             (* no gadgets       *)
  236.       CustomBitMap := NULL;                        (* no superbitmap   *)
  237.     END; (* WITH ns *) 
  238.  
  239.     scrnptr := OpenScreen(ADR(ns));
  240.     IF scrnptr = NULL THEN
  241.       WriteString ('Can`t open your screen'); WriteLn;
  242.       CloseLibrary (IntuitionBase);
  243.       CloseLibrary (GraphicsBase);
  244.       HALT;
  245.     END; (* IF scrnptr *)
  246.   END Setup;
  247.  
  248. PROCEDURE PutStuffOnScreen; (* This Procedure puts some stuff on *)
  249.                             (* our screen to manipulate with our *)
  250.   BEGIN                     (* Assembly Language routine.        *)
  251.     rp := ADR(scrnptr^.RPort);
  252.  
  253.     SetRast (rp, 0); (* Clear the Screen to black *)
  254.  
  255.     SetAPen (rp, 2); (* Set to color 2 *)
  256.  
  257.     RectFill (rp, 15, 15, 55, 85);            (* draw a bunch of *)
  258.     RectFill (rp, 100, 150, 250, 199);        (* haphazard rects *)
  259.     RectFill (rp, 250, 15, 319, 65); 
  260.     RectFill (rp, 160, 70, 235, 180);
  261.  
  262.    (* Set mode to Inverse video *)
  263.     SetDrMd (rp, DrawingModeSet {Complement});
  264.  
  265.     message := 'CODE Demo'; (* What I want to print on the background *)
  266.  
  267.     y := 25;
  268.     FOR x := 25 TO 190 BY 20 DO    (* print a pretty pattern *)
  269.       Move (rp, x, y);
  270.       Text (rp, message, 9);(* 9 = num of chars in message*)
  271.       INC (y,20);
  272.     END; (* x *)
  273.   END PutStuffOnScreen;
  274.  
  275. (* The following Procedure puts the bitplane addresses into a   *)
  276. (* record so we can pass them to our Assembly Language routine. *)
  277. (* We pass the address of the record to the Assembly Language   *)
  278. (* routine in the A0 register.                                  *)
  279.  
  280. PROCEDURE InitializeCodeParameters;
  281.   
  282.   BEGIN
  283.     WITH codeinfo DO
  284.       BPlane1 := scrnptr^.RPort.bitMap^.Planes[0]; (* address plane 1 *)
  285.       BPlane2 := scrnptr^.RPort.bitMap^.Planes[1]; (* address plane 2 *)
  286.       count   := 4000;    (* 4000 words in one BitPlane of information *)
  287.     END; (* WITH codeinfo *)
  288.   END InitializeCodeParameters;
  289.  
  290. (* The following Procedure shuts down our coprocessing Task "Walk" *)
  291. (* by clearing the Global Variable "terminate". It then waits for  *)
  292. (* the Task to answer with a value of 2 in the terminate variable. *)
  293. (* Why ?? Because if we just call RemTask we might remove our Task *)
  294. (* while its executing the WaitTOF routine. If that happens, we    *)
  295. (* corrupt the Operating System and can expect to visit the GURU   *)
  296. (* when the Program is finished. <It took numerous visits from the *)
  297. (* GURU to figure that one out. Sure wish AMIGA literature would   *)
  298. (* warn us about things like that.> The rest of the Procedure just *)
  299. (* cleans up and closes us down.                                   *)  
  300.  
  301. PROCEDURE ShutdownAndCleanup;
  302.  
  303.   BEGIN
  304.     IF (WalkTaskPoint <> NULL) THEN
  305.       terminate:=0; WHILE (terminate <> 2) DO number:=0; END;
  306.       RemTask(WalkTaskPoint);
  307.       FreeMem(WalkTaskPoint,WalkSize);
  308.     END;
  309.     IF (codeinfo.count<>0) THEN number:=50; ELSE number:=10; END;
  310.     IF (FlySprite<>-1) THEN
  311.       ChangeSprite(ADR(scrnptr^.VPort),SpriteData,Fly[0]);
  312.       Delay (LONG(number));    
  313.       FreeSprite(VAL(CARDINAL,FlySprite));
  314.     ELSE Delay (LONG(number));
  315.     END;
  316.     IF (Fly[0]<>NULL) THEN FreeMem(Fly[0],LONG(200));END;
  317.  
  318.     CloseScreen (scrnptr);
  319.     CloseLibrary (IntuitionBase);
  320.     CloseLibrary (GraphicsBase);
  321.   END ShutdownAndCleanup;
  322.  
  323. BEGIN
  324.   Setup;                    (* Open Libraries and Screen          *)
  325.   PutStuffOnScreen;         (* Draw some stuff on the Screen      *)
  326.   InitializeCodeParameters; (* Get Parameters to pass to our CODE *)
  327.   MakeInterrupt;            (* Setup termination Interrupt        *)
  328.   MakeFly;                  (* Create and Display Sprite imagery  *)
  329.   Delay (LONG(50));         (* Let user see whats here.           *)
  330.   IF (FlySprite <> -1) THEN StartWalk; END; (* Activate Walk Task *)
  331.  
  332.   AddIntServer(3,KillerPoint); (* Install our Interrupt *)
  333.   RegStore := REGISTER(8);     (* Store A0 *)
  334.   SETREG (8, ADR(codeinfo));   (* Pass parameters to CODE in A0 *)
  335.  
  336. CODE(18663,65534,17031,15912,8,26368,408,10247,57932,21380,36604,
  337.      200,21831,8764,0,4,9832,4,11324,0,320,19048,8,26368,372,8808,
  338.      0,9320,4,9276,0,199,9735,17024,57817,25600,6,2240,0,2065,
  339.      7,26368,8,2281,0,65535,57818,25600,6,2240,1,2066,7,26368,
  340.      8,2282,0,65535,57817,2065,7,26368,8,2281,0,65535,57818,2066,
  341.      7,26368,8,2282,0,65535,20939,65502,2217,0,65535,2218,0,65535,
  342.      2048,0,26368,6,21033,65535,2048,1,26368,6,21034,65535,20938,
  343.      65410,20937,26,10756,10315,8724,2689,32768,32768,10433,20941,
  344.      65524,8764,0,4,20942,65356,11324,0,318,19048,8,26368,184,
  345.      8808,0,9276,0,199,9735,17024,57817,25600,6,2240,0,2065,7,
  346.      26368,8,2281,0,65535,57817,2065,7,26368,8,2281,0,65535,20939,
  347.      65518,2217,0,65535,2048,0,26368,6,21033,65535,20938,65468,
  348.      20942,65446,11324,0,318,19048,8,26368,86,8808,4,9276,0,199,
  349.      9735,17024,57817,25600,6,2240,0,2065,7,26368,8,2281,0,65535,
  350.      57817,2065,7,26368,8,2281,0,65535,20939,65518,2217,0,65535,
  351.      2048,0,26368,6,21033,65535,20938,65468,20942,65446,19679,
  352.      32767);
  353.  
  354.   SETREG (8, RegStore);        (* Restore register A0  *)
  355.   RemIntServer(3,KillerPoint); (* Remove our Interrupt *)
  356.  
  357.   ShutdownAndCleanup;          (* Self Explanatory     *)
  358.  
  359. END CODEDemo.
  360.  
  361. (* The following is the Assembly listing for the CODE statement *)
  362. (* used in the above Modula-2 Program Module.                   *)
  363. (*
  364.                ORIGIN  START
  365. PLANE1         EQUATE  $00               ;DECLARE DATA OFFSETS
  366. PLANE2         EQUATE  $04               ;FROM PARAMETER REGISTER A0
  367. SIZE           EQUATE  $08               ;PASSED FROM MODULA2
  368.  
  369. START          MOVEM.L D0-D7/A0-A6,-(A7) ;SAVE REGISTERS ON STACK
  370.  
  371.                CLR.L   D7                ;CLEAR PLANE WIDTH REGISTER
  372.                MOVE.W  SIZE(A0),D7       ;GET PLANE SIZE
  373.                BEQ     QUIT              ;QUIT IF SIZE IS ZERO
  374.                MOVE.L  D7,D4             ;GET PLANESIZE
  375.                LSR     #1,D4             ;SHIFT TO HALVE
  376.                SUBQ.L  #1,D4             ;ADJUST FOR DBRA IN LOOP
  377.                DIVU    #200,D7           ;CALCULATE PLANE WIDTH IN WORDS
  378.                SUBQ.W  #2,D7             ;ADJUST FOR USE AS LOOP COUNT
  379.                MOVE.L  #4,D1             ;INITIALIZE STROBE COUNTER
  380.                MOVE.L  PLANE2(A0),A3     ;GET PLANE2 ADDRESS FOR STROBE
  381.  
  382.  
  383.                MOVE.L  #320,D6           ;TOTAL REPETITIONS
  384. LOOP3          TST.W   SIZE(A0)          ;CHECK FOR INTERRUPT
  385.                BEQ     QUIT              ;QUIT IF CLEARED BY INTERRUPT
  386.                MOVE.L  PLANE1(A0),A1     ;GET PLANE1 ADDRESS
  387.                MOVE.L  PLANE2(A0),A2     ;GET PLANE2 ADDRESS
  388.  
  389.                MOVE.L  #199,D2           ;SET HORIZONTAL SIZE LOOP COUNT
  390. LOOP2          MOVE.L  D7,D3             ;RESET LOOP COUNTER
  391.                CLR.L   D0                ;INITIALIZE BITCATCHER REGISTER
  392.                ASL     (A1)+             ;START HORIZONTAL SHIFT OF PLANE1
  393.                BCC     SKIP              ;SKIP IF BIT WAS 0
  394.                BSET    #0,D0             ;SAVE SHIFTED BIT
  395. SKIP           BTST.B  #7,(A1)           ;CHECK HIGH BIT OF NEXT WORD
  396.                BEQ     SKIP1             ;SKIP IF BIT WAS 0
  397.                BSET.B  #0,-1(A1)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  398. SKIP1          ASL     (A2)+             ;START HORIZONTAL SHIFT OF PLANE2
  399.                BCC     SKIP2             ;SKIP IF BIT WAS 0
  400.                BSET    #1,D0             ;SAVE SHIFTED BIT
  401. SKIP2          BTST.B  #7,(A2)           ;CHECK HIGH BIT OF NEXT WORD
  402.                BEQ     LOOP              ;SKIP IF BIT WAS 0
  403.                BSET.B  #0,-1(A2)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  404. LOOP           ASL     (A1)+             ;SHIFT REST OF LINE IN PLANE1
  405.                BTST.B  #7,(A1)           ;CHECK HIGH BIT OF NEXT WORD
  406.                BEQ     SKIP3             ;SKIP IF BIT WAS 0
  407.                BSET.B  #0,-1(A1)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  408. SKIP3          ASL     (A2)+             ;SHIFT REST OF LINE IN PLANE2
  409.                BTST.B  #7,(A2)           ;CHECK HIGH BIT OF NEXT WORD
  410.                BEQ     SKIP4             ;SKIP IF BIT WAS 0
  411.                BSET.B  #0,-1(A2)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  412. SKIP4          DBRA    D3,LOOP           ;LOOP TILL LINE DONE
  413.                BCLR.B  #0,-1(A1)         ;CLEAR LOW BIT OF LAST WORD
  414.                BCLR.B  #0,-1(A2)         ;CLEAR LOW BIT OF LAST WORD
  415.                BTST    #0,D0             ;CHECK FOR BIT FROM START OF LINE
  416.                BEQ     SKIP5             ;SKIP IF BIT WAS 0
  417.                ADDQ.B  #1,-1(A1)         ;SHIFT BIT FROM START OF LINE
  418. SKIP5          BTST    #1,D0             ;CHECK FOR BIT FROM START OF LINE
  419.                BEQ     SKIP6             ;SKIP IF BIT WAS 0
  420.                ADDQ.B  #1,-1(A2)         ;SHIFT BIT FROM START OF LINE
  421. SKIP6          DBRA    D2,LOOP2          ;LOOP TILL PLANES ARE SHIFTED
  422.  
  423.                DBRA    D1,SKIPSTROBE     ;SKIP COLOR CHANGE
  424.                MOVE.L  D4,D5             ;GET PLANESIZE
  425.                MOVE.L  A3,A4             ;GET PLANE ADDRESS
  426. COLORLOOP      MOVE.L  (A4),D1           ;GET PLANELONGWORD
  427.                EORI.L  #$80008000,D1     ;REVERSE BITS
  428.                MOVE.L  D1,(A4)+          ;REPLACE PLANELONGWORD
  429.                DBRA    D5,COLORLOOP      ;LOOP
  430.                MOVE.L  #4,D1             ;RESET COUNTER           
  431. SKIPSTROBE     DBRA    D6,LOOP3          ;LOOP TILL SCROLL DONE
  432.  
  433.                                          ;SCROLL PLANE1
  434.  
  435.                MOVE.L  #318,D6           ;TOTAL REPETITIONS
  436. LOOP3A         TST.W   SIZE(A0)          ;CHECK FOR INTERRUPT
  437.                BEQ     QUIT              ;QUIT IF CLEARED BY INTERRUPT
  438.                MOVE.L  PLANE1(A0),A1     ;GET PLANE1 ADDRESS
  439.                MOVE.L  #199,D2           ;SET HORIZONTAL SIZE LOOP COUNT
  440.  
  441. LOOP2A         MOVE.L  D7,D3             ;RESET LOOP COUNTER
  442.                CLR.L   D0                ;INITIALIZE BITCATCHER REGISTER
  443.                ASL     (A1)+             ;START HORIZONTAL SHIFT OF PLANE1
  444.                BCC     SKIPA             ;SKIP IF BIT WAS 0
  445.                BSET    #0,D0             ;SAVE SHIFTED BIT
  446. SKIPA          BTST.B  #7,(A1)           ;CHECK HIGH BIT OF NEXT WORD
  447.                BEQ     LOOPA             ;SKIP IF BIT WAS 0
  448.                BSET.B  #0,-1(A1)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  449. LOOPA          ASL     (A1)+             ;SHIFT REST OF LINE IN PLANE1
  450.                BTST.B  #7,(A1)           ;CHECK HIGH BIT OF NEXT WORD
  451.                BEQ     SKIP3A            ;SKIP IF BIT WAS 0
  452.                BSET.B  #0,-1(A1)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  453. SKIP3A         DBRA    D3,LOOPA          ;LOOP TILL LINE DONE
  454.                BCLR.B  #0,-1(A1)         ;CLEAR LOW BIT OF LAST WORD
  455.                BTST    #0,D0             ;CHECK FOR BIT FROM START OF LINE
  456.                BEQ     SKIP5A            ;SKIP IF BIT WAS 0
  457.                ADDQ.B  #1,-1(A1)         ;SHIFT BIT FROM START OF LINE
  458. SKIP5A         DBRA    D2,LOOP2A         ;LOOP TILL PLANES ARE SHIFTED
  459.                DBRA    D6,LOOP3A         ;LOOP TILL SCROLL DONE
  460.  
  461.                                          ;SCROLL PLANE2
  462.  
  463.                MOVE.L  #318,D6           ;TOTAL REPETITIONS
  464. LOOP3B         TST.W   SIZE(A0)          ;CHECK FOR INTERRUPT
  465.                BEQ     QUIT              ;QUIT IF CLEARED BY INTERRUPT
  466.                MOVE.L  PLANE2(A0),A1     ;GET PLANE1 ADDRESS
  467.                MOVE.L  #199,D2           ;SET HORIZONTAL SIZE LOOP COUNT
  468.  
  469. LOOP2B         MOVE.L  D7,D3             ;RESET LOOP COUNTER
  470.                CLR.L   D0                ;INITIALIZE BITCATCHER REGISTER
  471.                ASL     (A1)+             ;START HORIZONTAL SHIFT OF PLANE1
  472.                BCC     SKIPB             ;SKIP IF BIT WAS 0
  473.                BSET    #0,D0             ;SAVE SHIFTED BIT
  474. SKIPB          BTST.B  #7,(A1)           ;CHECK HIGH BIT OF NEXT WORD
  475.                BEQ     LOOPB             ;SKIP IF BIT WAS 0
  476.                BSET.B  #0,-1(A1)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  477. LOOPB          ASL     (A1)+             ;SHIFT REST OF LINE IN PLANE1
  478.                BTST.B  #7,(A1)           ;CHECK HIGH BIT OF NEXT WORD
  479.                BEQ     SKIP3B            ;SKIP IF BIT WAS 0
  480.                BSET.B  #0,-1(A1)         ;MOVE TO LOW BIT OF PREVIOUS WORD
  481. SKIP3B         DBRA    D3,LOOPB          ;LOOP TILL LINE DONE
  482.                BCLR.B  #0,-1(A1)         ;CLEAR LOW BIT OF LAST WORD
  483.                BTST    #0,D0             ;CHECK FOR BIT FROM START OF LINE
  484.                BEQ     SKIP5B            ;SKIP IF BIT WAS 0
  485.                ADDQ.B  #1,-1(A1)         ;SHIFT BIT FROM START OF LINE
  486. SKIP5B         DBRA    D2,LOOP2B         ;LOOP TILL PLANES ARE SHIFTED
  487.                DBRA    D6,LOOP3B         ;LOOP TILL SCROLL DONE
  488.  
  489.  
  490. QUIT           MOVEM.L (A7)+,D0-D7/A0-A6 ;RESTORE REGISTERS FROM STACK
  491.                END                       ;FINISHED SCROLLING
  492.  *)
  493.  
  494. (* Note-This routine could be shortened by reusing the single plane
  495.    scroll for both planes. Don't know why we didn't do it. *)
  496.  
  497. (* Note2-Actually the whole routine could be much shorter and quicker,
  498.    but what's the point. It'll never beat the Blitter *)
  499.  
  500. (* Note3-Some of the code and techniques in the main Program may be
  501.    questionable?? Just experimenting--The real objective was to
  502.    demonstrate a Modula-2 CODE statement.                     *)
  503.  
  504.